home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGASIC
/
BASFILES.LZH
/
QBTXINST.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-09-10
|
3KB
|
112 lines
'$INCLUDE:'QBTOOLS.INC'
'' '$INCLUDE: 'qbtools2.inc'
'' '$INCLUDE: 'qbt2indx.inc'
'' '-------------------------Standard Include Merge Section-------------------
DEFSNG A-Z
SUB IndexInsert (IxNum%, Ky$, Mrec%, Xnm$(), Xk$(), Xh%(), sc%) STATIC
' insert a new key into the index
' use the new method, access the deletions stack.
sc% = 0 ' no success yet
IF Mrec% < 1 THEN
sc% = -1
END IF
IF LEN(Ky$) < 1 THEN
sc% = -2
END IF
' a check is needed to see if the index has grown to it's maximum
' size. a note here on how to make this index handle records greater
' than 32767. all the cvi and mki$ routines should be changed to cvs
' and mks$. also, all refernces to % (where the % is a pointer value
' in the index) should be changed to ! . the record size will increase
' as well, because the pointer fields change in length from 2 bytes to
' 4 bytes.
IF Xh%(IxNum%, 2) = 32767 THEN
sc% = -3
END IF
IF sc% < 0 THEN
EXIT SUB
END IF
' if the length of ky$ is less than the length of the max size for
' the key, then ky$ will be padded with blanks
IF LEN(Ky$) < Xh%(IxNum%, 1) THEN
Ky$ = Ky$ + STRING$(Xh%(IxNum%, 1) - LEN(Ky$), 32)
END IF
rrec% = 1
Lp% = 0
WHILE Lp% = 0
prrec% = rrec% ' hold the recnum for eval
GET #IxNum%, rrec%
IF CVI(Xk$(IxNum%, 5)) = 0 THEN
GOTO place ' this is where the key goes
END IF
IF Ky$ < Xk$(IxNum%, 1) THEN
side% = 2
ELSE
side% = 3
END IF
rrec% = CVI(Xk$(IxNum%, side%))
IF rrec% = 0 THEN
Lp% = 1 ' this is where the key goes
END IF
WEND
place:
IF Xh%(IxNum%, 4) THEN
Gf% = 4
ELSE
Gf% = 3
END IF
GET #IxNum%, Xh%(IxNum%, Gf%)
nrec% = CVI(Xk$(IxNum%, 6))
LSET Xk$(IxNum%, 1) = Ky$
IF Xh%(IxNum%, 3) <> 1 THEN
GOTO nfirst ' not the first record
END IF
LSET Xk$(IxNum%, 4) = MKI$(0) ' initialize
GOTO other
nfirst:
LSET Xk$(IxNum%, 4) = MKI$(prrec%)
other:
LSET Xk$(IxNum%, 3) = MKI$(0)
LSET Xk$(IxNum%, 2) = MKI$(0)
LSET Xk$(IxNum%, 5) = MKI$(Mrec%)
LSET Xk$(IxNum%, 6) = MKI$(0) ' next deleted
PUT #IxNum%, Xh%(IxNum%, Gf%)
IF Gf% = 3 THEN
IF Xh%(IxNum%, 3) = 1 THEN
GOTO increment
END IF
END IF
GET #IxNum%, prrec%
LSET Xk$(IxNum%, side%) = MKI$(Xh%(IxNum%, Gf%))
PUT #IxNum%, prrec%
increment:
IF Gf% = 4 THEN
Xh%(IxNum%, 4) = nrec%
ELSE
Xh%(IxNum%, 4) = 0
Xh%(IxNum%, 3) = Xh%(IxNum%, 3) + 1
LSET Xk$(IxNum%, 1) = STRING$(Xh%(IxNum%, 1), 0)
FOR j% = 2 TO 6
LSET Xk$(IxNum%, j%) = MKI$(0)
NEXT j%
PUT #IxNum%, Xh%(IxNum%, 3)
END IF
Xh%(IxNum%, 2) = Xh%(IxNum%, 2) + 1
sc% = 1
END SUB